Ham Radio 2000 #2/Ham Radio 2000 - Volume 2.iso/HAMV2/MISC/TSTHFLT2/TSTHUNIT.PAS

Pascal/Delphi Source File | 1996-12-01 | 13.1 KB | 419 lines

{(s0p16h0s0b4099T}
Unit TSTHunit;

Interface
{
  This program source is a Turbo Pascal 7.0 utility for TstHost 1.41 and
  higher.
  This program accesses TstHost for information about the status of the
  program and the tasks. Extended data request will be done trough the
  internally IQR service vector, normally 101, 65Hex. This vector
  may be redefined with the command TstHost /V, that accept in input a
  DECIMAL value. This program is tested with TstHost 1.43b.
  Written by Reg, PE1PKD, BLOKKER in HOLLAND.
  Packet address : PE1PKD @ PI8WFL.#NH1.NLD.EU
}

Uses Dos, Strings;

Type
  DateStr = String[22];
  InfoRec = Record
              Version        : String[5];
              MaxChannel     : Integer;
              DrvType        : Byte;
              Port           : Byte;
              Baudrate       : Word;
              IntNo          : Integer;
              TstHostCall    : String[10];
              UListEnable    : Byte;
              Wpath          : String[81];
              Upath          : String[101];
              HomeBBS        : String[10];
              HomeAlias      : String[10];
              ChStatus       : Integer;
              SuppCall       : String[10];
              UserCall       : String[10];
              UIname         : String[13];
              UILastConnTime : DateStr;
              UILastMsgList  : DateStr;
              UINbrConn      : LongInt;
              UIThisConnTime : DateStr;
              SysFlag        : Word;
              ExtraInfo      : String[10];
            End;
            ChannelList      = Array[0..8] of InfoRec;

Var
  ChannelData      : ChannelList;     {All record data off the channels}
  TstHostPath      : String;          {Path where TSHOST.EXE is located}

Function UpcaseStr(Str : String) : String;

Procedure GetTstHostIRQVector(Var IRQNumber     : Byte;
                              Var TstHostActive : Boolean);

Function GetTstHostPath : String;

Procedure GetChannelsInfo(IRQVector : Byte);

Implementation

Type
  InfoTstHostRec = Record
     (* This record is translated from the C layout from the manual into
        Turbo Pascal 7.0 layout. The record names are exactly the same as
        described in the manual.*)
     (* THIS FIELDS ARE GLOBALS, NOT CHANNEL DEPANDANT.*)
     (*=============================================== *)
     THVH           : Byte;                  (*TstHost version, high value*)
     THVL           : Byte;                  (*TstHost version, low value*)
     MaxChannel     : Integer;               (*Number of channels available in TstHost*)
     DrvType        : Byte;                  (*Driver type, 1 real host, 0 tfpcx, 2 drsi*)
     Port           : Byte;                  (*If real host, com port*)
     Baudrate       : Word;                  (*If real host, baudrate*)
     IntNo          : Integer;               (*If tfpcx/r, irq vector used by driver*)
     TstHostCall    : Array[0..9] of Char;   (*Callsign of the system, with ssid*)
     UListEnable    : Byte;                  (*If not 0, unproto list is  active*)
     Wpath          : Array[0..80] of Char;  (*TstHost WorkDir*)
     Upath          : Array[0..100] of Char; (*TstHost UserDir, if more than one path*)
                                             (*is defined, the multiple path are*)
                                             (*separated by a space.*)
     HomeBBS        : Array[0..9] of Char;   (*HomeBBS Callsign*)
     HomeAlias      : Array[0..9] of Char;   (*HomeBBS alias call, null if undefined*)

     (* THIS FIELDS ARE CHANNEL DEPANDANT*)
     (*====================================================*)
     ChStatus       : Integer;               (*0 = channel is disconnected*)
                                             (*1 = standard connection, i have connect*)
                                             (*    another OM*)
                                             (*2 = PMS connection, a remote user is*)
                                             (*  = connected on my pms*)
                                             (*3 = PMS connection, HomeBBS have connect*)
                                             (*  = my pms to do forward.*)
                                             (*4 = PMS connection, my pms have connect*)
                                             (*    HomeBBS to do forward*)
                                             (*5 = UNPROTO connection, i have connect*)
                                             (*    HomeBBS to request unproto mail.*)
     SuppCall       : Array[0..9] of Char;   (*If not null, extra callsign for the*)
                                             (*channel (command AX PORT)*)
     UserCall       : Array[0..9] of Char;   (*Call of the connected station, with ssid*)

     (* THIS FIELDS ARE VALID ONLY FOR USER THAT HAVE CONNECT*)
     (* MY PMS, chstatus=2 o 3*)
     (*=====================================================*)
     UIname         : Array[0..12] of Char;  (*User name*)
     UILastConnTime : LongInt;               (*In sec dated since 1970, last connection date*)
     UILastMsgList  : LongInt;               (*In sec, last messaged listed date*)
     UINbrConn      : LongInt;               (*Number of connection for this user*)
     UIThisConnTime : LongInt;               (*In second, this date at connection*)
     SysFlag        : Word;                  (*Actual SYS flag for the user*)
   End;

Var
  Point            : ^InfoTstHostRec; {Typed pointer}


Function UpcaseStr;

(* This function upcase all characters in the line *)

Var
  Counter : Byte;

Begin
  For Counter := 1 To Length(Str) Do
    Str[Counter] := Upcase(Str[Counter]);
  UpcaseStr := Str;
End;


Function IntToStr(I : LongInt) : String;

(* This function convert an Integer type to a string format *)

Var
  S : String[11];

Begin
  Str(I, S);
  While Length(S) < 2 Do S := '0' + S;
  IntToStr := S;
End;


Function CallExpand(Call : String) : String;

(* This function make sure that the given String in maded 10 characters length *)

Begin
  If Length(Call) > 0 then
    While Length(Call) <= 10 do Call := Call + ' ';
  CallExpand := Call;
End;


Function GetTstHostPath;

{ This function is returning the path where TstHost.exe is located. }

Var
  PathName     : PathStr;
  DirName      : Dirstr;
  ProgName     : NameStr;
  ExtName      : ExtStr;
  DirInfo      : SearchRec;
  PGPos        : Byte;

Begin
  PathName := Fexpand(ParamStr(0));
  FSplit(PathName,DirName,ProgName,ExtName);
  PGPos := Pos('PG',DirName);
  If PGPos = 0 then GetTstHostPath := DirName
    else GetTstHostPath := Copy(DirName,1,PGPos-1);
End;


Procedure GetTstHostIRQVector;

{ Read the IRQ vector from file TstHost.IRQ. This file only exist
  when TstHost is started. This procedure checks or file exist and
  so if TstHost is started.}

Var
  IRQString,
  Line,
  TstHostIRQName : String;
  TstHostIRQRead : Text;
  DirInfo        : SearchRec;
  Code           : Integer;
  IRQPos         : Byte;

Begin
  (* First check or this program is called under TstHost operation! *)
  TstHostActive := True;
  TstHostIRQName := GetTstHostPath + 'TstHost.IRQ';

  FindFirst(TstHostIRQName,AnyFile,DirInfo);
  If DosError > 0 then
  Begin
    TstHostActive := False;
    Exit;
  End;

  (* Get the IRQvector number from file TstHost.IRQ *)
  Assign(TstHostIRQRead, TstHostIRQName);
  {$I-}
  Reset(TstHostIRQRead);
  {SI+}
  If IOResult <> 0 then
  Begin
    TstHostActive := False;
    Exit;
  End;

  Repeat
    Readln(TstHostIRQRead,Line);
    IRQPos := Pos('=',Line);
    IRQString := Copy(Line,IRQPos+1,3);
    Val(IRQString,IRQNumber,Code);
    If (IRQPos = 0) or (Code <> 0) Then
    Begin
      TstHostActive := False;
      Exit;
    End;
  Until Eof(TstHostIRQRead);

  Close(TstHostIRQRead);
End;


Function Convert_SecondsToDate(Start_Seconds : LongInt) : DateStr;

(* This function return a date calculated from seconds input since 1970 counted *)
(* Also calculating the UTC difference getting the set variable "TZ" *)

Const
  DaysInMonth : Array[1..12] of Byte =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DaysInMonth_LeapYear : Array[1..12] of Byte =
    (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  DaysInWeek : Array[0..6] of String[3] =
    ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  MonthStr : Array[1..12] of String[3] =
    ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');

  Seconds_Day      = 86400;
  Seconds_Year     = 86400 * 365;
  Seconds_LeapYear = 86400 * 366;

Var
  DaySeconds,
  Seconds     : LongInt;
  Min,
  Hour,
  Day,
  Month,
  Year        : Word;
  Code,
  UTCOffset   : Integer;
  TZ          : String;

Begin

  Year := 1970;
  Seconds := Start_Seconds;

  (* Correction for the UTC time *)
  TZ := GetEnv('TZ');
  UTCOffset := 4;
  If TZ <> '' then
  Begin
    Val(Copy(TZ,4,2),UTCOffset,Code);
    If Code <> 0 then UTCOffset := 4;
  End;

  Seconds := Seconds - (UTCOffset * 3600);
  DaySeconds := Seconds;

  While ((Year MOD 4) = 0) and (Seconds - (Seconds_LeapYear) > 0) or
        ((Year MOD 4) > 0) and (Seconds - (Seconds_Year) > 0) do
  Begin
    If Year MOD 4 = 0 then
    Begin
      If Seconds - Seconds_LeapYear > 0 then
      Begin
        Inc(Year);
        Seconds := Seconds - Seconds_LeapYear;
      End;
    End else
    Begin
      If Seconds - Seconds_Year > 0 then
      Begin
        Inc(Year);
        Seconds := Seconds - Seconds_Year;
      End;
    End;
  End;

  Month := 1;
  If Year MOD 4 = 0 then
  Begin
    While Seconds - (DaysInMonth_LeapYear[Month] * Seconds_Day) > 0 do
    Begin
      Seconds := Seconds - (DaysInMonth_LeapYear[Month] * Seconds_Day);
      Inc(Month);
    End;
  End Else
  Begin
    While Seconds - (DaysInMonth[Month] * Seconds_Day) > 0 do
    Begin
      Seconds := Seconds - (DaysInMonth[Month] * Seconds_Day);
      Inc(Month);
    End;
  End;

  Day       := (Seconds DIV Seconds_Day) + 1;
  Seconds   := Seconds MOD Seconds_Day;
  Hour      := Seconds DIV 3600;
  Seconds   := Seconds MOD 3600;
  Min       := Seconds DIV 60;
  Seconds   := Seconds MOD 60;

  Convert_SecondsToDate := DaysInWeek[((DaySeconds DIV Seconds_Day) + 4) MOD 7] +
                           ' ' + IntToStr(Day) + '-' + MonthStr[Month] + '-' +
                           Copy(IntToStr(Year),3,2) +' ' + IntToStr(Hour) + ':' +
                           IntToStr(Min) + ':' + IntToStr(Seconds) ;
End;


Procedure GetPointerInfo(TstHostIRQ : Byte;  Channel : Byte);

{ This procedure gets the information from the memory location.
  WARNING : On page 8 of the TSHOST 1.43 manual is mensioned that
  register AH is set to the specified channel to investigate. This must
  be register AL! }

Var
  Reg : Registers;

Begin
  With Reg do
  Begin
    AL := Channel;
    AH := 0;
    Intr(TstHostIRQ, Reg);
    If AH <> 0 Then {When returning AH must be 0}
    Begin
      Writeln('Can''t connect to TstHost.');
      Halt(0);
    End;
    Point := Ptr(ES,BX);
  End;
End;


Procedure GetChannelsInfo;

{ Scans all channels and get the data }

Var
  Channel     : Byte;

Begin
  GetPointerInfo(IRQVector,0); {First scan the MONITOR channel}
  For Channel := 0 to Point^.MaxChannel do { Scan the channels 1 to max.}
  Begin
    GetPointerInfo(IRQVector,Channel);
    With ChannelData[Channel] do
    Begin
      Str(Point^.THVH,Version);
      Version        := Version + '.' + IntToStr(Point^.THVL);
      MaxChannel     := Point^.MaxChannel;
      DrvType        := Point^.DrvType;
      Port           := Point^.Port;
      Baudrate       := Point^.BaudRate;
      Intno          := Point^.IntNo;
      TstHostCall    := CallExpand(StrPas(Point^.TstHostCall));
      UListEnable    := Point^.UListEnable;
      Wpath          := StrPas(Point^.WPath);
      Upath          := StrPas(Point^.Upath);
      HomeBbs        := CallExpand(StrPas(Point^.HomeBBS));
      HomeAlias      := CallExpand(StrPas(Point^.HomeAlias));
      Chstatus       := Point^.ChStatus;
      SuppCall       := CallExpand(StrPas(Point^.SuppCall));
      UserCall       := CallExpand(StrPas(Point^.UserCall));
      If (ChStatus = 2) or (ChStatus = 3) then
      Begin
        UIname         := StrPas(Point^.UIName);
        If Point^.UILastConnTime = 0 then UILastConnTime := '' else
          UILastConnTime := Convert_SecondsToDate(Point^.UILastConnTime);
        If Point^.UILastMsgList = 0 then UILastMsgList := '' else
          UILastMsgList  := Convert_SecondsToDate(Point^.UILastMsgList);
        UINbrConn      := Point^.UINbrConn;
        If Point^.UIThisConnTime = 0 then UIThisConnTime := '' else
          UIThisConnTime := Convert_SecondsToDate(Point^.UIThisConnTime);
        SysFlag        := Point^.SysFlag;
        ExtraInfo      := '';
      End Else
      Begin
        UIname         := '';
        UILastConnTime := '';
        UILastMsgList  := '';
        UINbrConn      := 0;
        UIThisConnTime := '';
        SysFlag        := 0;
        ExtraInfo      := '';
      End;
    End;

  End;
End;


End. {unit}